home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / dejagnu.lha / dejagnu-1.0.1 / tcl / tclParse.c < prev    next >
C/C++ Source or Header  |  1993-02-14  |  33KB  |  1,201 lines
  1. /* 
  2.  * tclParse.c --
  3.  *
  4.  *    This file contains a collection of procedures that are used
  5.  *    to parse Tcl commands or parts of commands (like quoted
  6.  *    strings or nested sub-commands).
  7.  *
  8.  * Copyright 1991 Regents of the University of California.
  9.  * Permission to use, copy, modify, and distribute this
  10.  * software and its documentation for any purpose and without
  11.  * fee is hereby granted, provided that the above copyright
  12.  * notice appear in all copies.  The University of California
  13.  * makes no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without
  15.  * express or implied warranty.
  16.  */
  17.  
  18. #include "tclInt.h"
  19.  
  20. /*
  21.  * The following table assigns a type to each character.  Only types
  22.  * meaningful to Tcl parsing are represented here.  The table indexes
  23.  * all 256 characters, with the negative ones first, then the positive
  24.  * ones.
  25.  */
  26.  
  27. char tclTypeTable[] = {
  28.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  29.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  30.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  31.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  32.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  33.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  34.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  35.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  36.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  37.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  38.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  39.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  40.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  41.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  42.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  43.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  44.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  45.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  46.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  47.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  48.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  49.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  50.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  51.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  52.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  53.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  54.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  55.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  56.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  57.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  58.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  59.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  60.     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  61.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  62.     TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END,   TCL_SPACE,
  63.     TCL_SPACE,         TCL_SPACE,         TCL_NORMAL,        TCL_NORMAL,
  64.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  65.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  66.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  67.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  68.     TCL_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
  69.     TCL_DOLLAR,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  70.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  71.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  72.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  73.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  74.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_COMMAND_END,
  75.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  76.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  77.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  78.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  79.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  80.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  81.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  82.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACKET,
  83.     TCL_BACKSLASH,     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
  84.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  85.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  86.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  87.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  88.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  89.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  90.     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
  91.     TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,
  92. };
  93.  
  94. /*
  95.  * Function prototypes for procedures local to this file:
  96.  */
  97.  
  98. static char *    QuoteEnd _ANSI_ARGS_((char *string, int term));
  99. static char *    VarNameEnd _ANSI_ARGS_((char *string));
  100.  
  101. /*
  102.  *----------------------------------------------------------------------
  103.  *
  104.  * Tcl_Backslash --
  105.  *
  106.  *    Figure out how to handle a backslash sequence.
  107.  *
  108.  * Results:
  109.  *    The return value is the character that should be substituted
  110.  *    in place of the backslash sequence that starts at src, or 0
  111.  *    if the backslash sequence should be replace by nothing (e.g.
  112.  *    backslash followed by newline).  If readPtr isn't NULL then
  113.  *    it is filled in with a count of the number of characters in
  114.  *    the backslash sequence.  Note:  if the backslash isn't followed
  115.  *    by characters that are understood here, then the backslash
  116.  *    sequence is only considered to be one character long, and it
  117.  *    is replaced by a backslash char.
  118.  *
  119.  * Side effects:
  120.  *    None.
  121.  *
  122.  *----------------------------------------------------------------------
  123.  */
  124.  
  125. char
  126. Tcl_Backslash(src, readPtr)
  127.     char *src;            /* Points to the backslash character of
  128.                  * a backslash sequence. */
  129.     int *readPtr;        /* Fill in with number of characters read
  130.                  * from src, unless NULL. */
  131. {
  132.     register char *p = src+1;
  133.     char result;
  134.     int count;
  135.  
  136.     count = 2;
  137.  
  138.     switch (*p) {
  139.     case 'b':
  140.         result = '\b';
  141.         break;
  142.     case 'e':
  143.         result = 033;
  144.         break;
  145.     case 'f':
  146.         result = '\f';
  147.         break;
  148.     case 'n':
  149.         result = '\n';
  150.         break;
  151.     case 'r':
  152.         result = '\r';
  153.         break;
  154.     case 't':
  155.         result = '\t';
  156.         break;
  157.     case 'v':
  158.         result = '\v';
  159.         break;
  160.     case 'C':
  161.         p++;
  162.         if (isspace(*p) || (*p == 0)) {
  163.         result = 'C';
  164.         count = 1;
  165.         break;
  166.         }
  167.         count = 3;
  168.         if (*p == 'M') {
  169.         p++;
  170.         if (isspace(*p) || (*p == 0)) {
  171.             result = 'M' & 037;
  172.             break;
  173.         }
  174.         count = 4;
  175.         result = (*p & 037) | '\200';
  176.         break;
  177.         }
  178.         count = 3;
  179.         result = *p & 037;
  180.         break;
  181.     case 'M':
  182.         p++;
  183.         if (isspace(*p) || (*p == 0)) {
  184.         result = 'M';
  185.         count = 1;
  186.         break;
  187.         }
  188.         count = 3;
  189.         result = *p + '\200';
  190.         break;
  191.     case '}':
  192.     case '{':
  193.     case ']':
  194.     case '[':
  195.     case '$':
  196.     case ' ':
  197.     case ';':
  198.     case '"':
  199.     case '\\':
  200.         result = *p;
  201.         break;
  202.     case '\n':
  203.         result = 0;
  204.         break;
  205.     default:
  206.         if (isdigit(*p)) {
  207.         result = *p - '0';
  208.         p++;
  209.         if (!isdigit(*p)) {
  210.             break;
  211.         }
  212.         count = 3;
  213.         result = (result << 3) + (*p - '0');
  214.         p++;
  215.         if (!isdigit(*p)) {
  216.             break;
  217.         }
  218.         count = 4;
  219.         result = (result << 3) + (*p - '0');
  220.         break;
  221.         }
  222.         result = '\\';
  223.         count = 1;
  224.         break;
  225.     }
  226.  
  227.     if (readPtr != NULL) {
  228.     *readPtr = count;
  229.     }
  230.     return result;
  231. }
  232.  
  233. /*
  234.  *--------------------------------------------------------------
  235.  *
  236.  * TclParseQuotes --
  237.  *
  238.  *    This procedure parses a double-quoted string such as a
  239.  *    quoted Tcl command argument or a quoted value in a Tcl
  240.  *    expression.  This procedure is also used to parse array
  241.  *    element names within parentheses, or anything else that
  242.  *    needs all the substitutions that happen in quotes.
  243.  *
  244.  * Results:
  245.  *    The return value is a standard Tcl result, which is
  246.  *    TCL_OK unless there was an error while parsing the
  247.  *    quoted string.  If an error occurs then interp->result
  248.  *    contains a standard error message.  *TermPtr is filled
  249.  *    in with the address of the character just after the
  250.  *    last one successfully processed;  this is usually the
  251.  *    character just after the matching close-quote.  The
  252.  *    fully-substituted contents of the quotes are stored in
  253.  *    standard fashion in *pvPtr, null-terminated with
  254.  *    pvPtr->next pointing to the terminating null character.
  255.  *
  256.  * Side effects:
  257.  *    The buffer space in pvPtr may be enlarged by calling its
  258.  *    expandProc.
  259.  *
  260.  *--------------------------------------------------------------
  261.  */
  262.  
  263. int
  264. TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
  265.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  266.                  * evaluations and error messages. */
  267.     char *string;        /* Character just after opening double-
  268.                  * quote. */
  269.     int termChar;        /* Character that terminates "quoted" string
  270.                  * (usually double-quote, but sometimes
  271.                  * right-paren or something else). */
  272.     int flags;            /* Flags to pass to nested Tcl_Eval calls. */
  273.     char **termPtr;        /* Store address of terminating character
  274.                  * here. */
  275.     ParseValue *pvPtr;        /* Information about where to place
  276.                  * fully-substituted result of parse. */
  277. {
  278.     register char *src, *dst, c;
  279.  
  280.     src = string;
  281.     dst = pvPtr->next;
  282.  
  283.     while (1) {
  284.     if (dst == pvPtr->end) {
  285.         /*
  286.          * Target buffer space is about to run out.  Make more space.
  287.          */
  288.  
  289.         pvPtr->next = dst;
  290.         (*pvPtr->expandProc)(pvPtr, 1);
  291.         dst = pvPtr->next;
  292.     }
  293.  
  294.     c = *src;
  295.     src++;
  296.     if (c == termChar) {
  297.         *dst = '\0';
  298.         pvPtr->next = dst;
  299.         *termPtr = src;
  300.         return TCL_OK;
  301.     } else if (CHAR_TYPE(c) == TCL_NORMAL) {
  302.         copy:
  303.         *dst = c;
  304.         dst++;
  305.         continue;
  306.     } else if (c == '$') {
  307.         int length;
  308.         char *value;
  309.  
  310.         value = Tcl_ParseVar(interp, src-1, termPtr);
  311.         if (value == NULL) {
  312.         return TCL_ERROR;
  313.         }
  314.         src = *termPtr;
  315.         length = strlen(value);
  316.         if ((pvPtr->end - dst) <= length) {
  317.         pvPtr->next = dst;
  318.         (*pvPtr->expandProc)(pvPtr, length);
  319.         dst = pvPtr->next;
  320.         }
  321.         strcpy(dst, value);
  322.         dst += length;
  323.         continue;
  324.     } else if (c == '[') {
  325.         int result;
  326.  
  327.         pvPtr->next = dst;
  328.         result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
  329.         if (result != TCL_OK) {
  330.         return result;
  331.         }
  332.         src = *termPtr;
  333.         dst = pvPtr->next;
  334.         continue;
  335.     } else if (c == '\\') {
  336.         int numRead;
  337.  
  338.         src--;
  339.         *dst = Tcl_Backslash(src, &numRead);
  340.         if (*dst != 0) {
  341.         dst++;
  342.         }
  343.         src += numRead;
  344.         continue;
  345.     } else if (c == '\0') {
  346.         Tcl_ResetResult(interp);
  347.         sprintf(interp->result, "missing %c", termChar);
  348.         *termPtr = string-1;
  349.         return TCL_ERROR;
  350.     } else {
  351.         goto copy;
  352.     }
  353.     }
  354. }
  355.  
  356. /*
  357.  *--------------------------------------------------------------
  358.  *
  359.  * TclParseNestedCmd --
  360.  *
  361.  *    This procedure parses a nested Tcl command between
  362.  *    brackets, returning the result of the command.
  363.  *
  364.  * Results:
  365.  *    The return value is a standard Tcl result, which is
  366.  *    TCL_OK unless there was an error while executing the
  367.  *    nested command.  If an error occurs then interp->result
  368.  *    contains a standard error message.  *TermPtr is filled
  369.  *    in with the address of the character just after the
  370.  *    last one processed;  this is usually the character just
  371.  *    after the matching close-bracket, or the null character
  372.  *    at the end of the string if the close-bracket was missing
  373.  *    (a missing close bracket is an error).  The result returned
  374.  *    by the command is stored in standard fashion in *pvPtr,
  375.  *    null-terminated, with pvPtr->next pointing to the null
  376.  *    character.
  377.  *
  378.  * Side effects:
  379.  *    The storage space at *pvPtr may be expanded.
  380.  *
  381.  *--------------------------------------------------------------
  382.  */
  383.  
  384. int
  385. TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
  386.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  387.                  * evaluations and error messages. */
  388.     char *string;        /* Character just after opening bracket. */
  389.     int flags;            /* Flags to pass to nested Tcl_Eval. */
  390.     char **termPtr;        /* Store address of terminating character
  391.                  * here. */
  392.     register ParseValue *pvPtr;    /* Information about where to place
  393.                  * result of command. */
  394. {
  395.     int result, length, shortfall;
  396.     Interp *iPtr = (Interp *) interp;
  397.  
  398.     result = Tcl_Eval(interp, string, flags | TCL_BRACKET_TERM, termPtr);
  399.     if (result != TCL_OK) {
  400.     /*
  401.      * The increment below results in slightly cleaner message in
  402.      * the errorInfo variable (the close-bracket will appear).
  403.      */
  404.  
  405.     if (**termPtr == ']') {
  406.         *termPtr += 1;
  407.     }
  408.     return result;
  409.     }
  410.     (*termPtr) += 1;
  411.     length = strlen(iPtr->result);
  412.     shortfall = length + 1 - (pvPtr->end - pvPtr->next);
  413.     if (shortfall > 0) {
  414.     (*pvPtr->expandProc)(pvPtr, shortfall);
  415.     }
  416.     strcpy(pvPtr->next, iPtr->result);
  417.     pvPtr->next += length;
  418.     Tcl_FreeResult(iPtr);
  419.     iPtr->result = iPtr->resultSpace;
  420.     iPtr->resultSpace[0] = '\0';
  421.     return TCL_OK;
  422. }
  423.  
  424. /*
  425.  *--------------------------------------------------------------
  426.  *
  427.  * TclParseBraces --
  428.  *
  429.  *    This procedure scans the information between matching
  430.  *    curly braces.
  431.  *
  432.  * Results:
  433.  *    The return value is a standard Tcl result, which is
  434.  *    TCL_OK unless there was an error while parsing string.
  435.  *    If an error occurs then interp->result contains a
  436.  *    standard error message.  *TermPtr is filled
  437.  *    in with the address of the character just after the
  438.  *    last one successfully processed;  this is usually the
  439.  *    character just after the matching close-brace.  The
  440.  *    information between curly braces is stored in standard
  441.  *    fashion in *pvPtr, null-terminated with pvPtr->next
  442.  *    pointing to the terminating null character.
  443.  *
  444.  * Side effects:
  445.  *    The storage space at *pvPtr may be expanded.
  446.  *
  447.  *--------------------------------------------------------------
  448.  */
  449.  
  450. int
  451. TclParseBraces(interp, string, termPtr, pvPtr)
  452.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  453.                  * evaluations and error messages. */
  454.     char *string;        /* Character just after opening bracket. */
  455.     char **termPtr;        /* Store address of terminating character
  456.                  * here. */
  457.     register ParseValue *pvPtr;    /* Information about where to place
  458.                  * result of command. */
  459. {
  460.     int level;
  461.     register char *src, *dst, *end;
  462.     register char c;
  463.  
  464.     src = string;
  465.     dst = pvPtr->next;
  466.     end = pvPtr->end;
  467.     level = 1;
  468.  
  469.     /*
  470.      * Copy the characters one at a time to the result area, stopping
  471.      * when the matching close-brace is found.
  472.      */
  473.  
  474.     while (1) {
  475.     c = *src;
  476.     src++;
  477.     if (dst == end) {
  478.         pvPtr->next = dst;
  479.         (*pvPtr->expandProc)(pvPtr, 20);
  480.         dst = pvPtr->next;
  481.         end = pvPtr->end;
  482.     }
  483.     *dst = c;
  484.     dst++;
  485.     if (CHAR_TYPE(c) == TCL_NORMAL) {
  486.         continue;
  487.     } else if (c == '{') {
  488.         level++;
  489.     } else if (c == '}') {
  490.         level--;
  491.         if (level == 0) {
  492.         dst--;            /* Don't copy the last close brace. */
  493.         break;
  494.         }
  495.     } else if (c == '\\') {
  496.         int count;
  497.  
  498.         /*
  499.          * Must always squish out backslash-newlines, even when in
  500.          * braces.  This is needed so that this sequence can appear
  501.          * anywhere in a command, such as the middle of an expression.
  502.          */
  503.  
  504.         if (*src == '\n') {
  505.         dst--;
  506.         src++;
  507.         } else {
  508.         (void) Tcl_Backslash(src-1, &count);
  509.         while (count > 1) {
  510.                     if (dst == end) {
  511.                         pvPtr->next = dst;
  512.                         (*pvPtr->expandProc)(pvPtr, 20);
  513.                         dst = pvPtr->next;
  514.                         end = pvPtr->end;
  515.                     }
  516.             *dst = *src;
  517.             dst++;
  518.             src++;
  519.             count--;
  520.         }
  521.         }
  522.     } else if (c == '\0') {
  523.         Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
  524.         *termPtr = string-1;
  525.         return TCL_ERROR;
  526.     }
  527.     }
  528.  
  529.     *dst = '\0';
  530.     pvPtr->next = dst;
  531.     *termPtr = src;
  532.     return TCL_OK;
  533. }
  534.  
  535. /*
  536.  *--------------------------------------------------------------
  537.  *
  538.  * TclParseWords --
  539.  *
  540.  *    This procedure parses one or more words from a command
  541.  *    string and creates argv-style pointers to fully-substituted
  542.  *    copies of those words.
  543.  *
  544.  * Results:
  545.  *    The return value is a standard Tcl result.
  546.  *    
  547.  *    *argcPtr is modified to hold a count of the number of words
  548.  *    successfully parsed, which may be 0.  At most maxWords words
  549.  *    will be parsed.  If 0 <= *argcPtr < maxWords then it
  550.  *    means that a command separator was seen.  If *argcPtr
  551.  *    is maxWords then it means that a command separator was
  552.  *    not seen yet.
  553.  *
  554.  *    *TermPtr is filled in with the address of the character
  555.  *    just after the last one successfully processed in the
  556.  *    last word.  This is either the command terminator (if
  557.  *    *argcPtr < maxWords), the character just after the last
  558.  *    one in a word (if *argcPtr is maxWords), or the vicinity
  559.  *    of an error (if the result is not TCL_OK).
  560.  *    
  561.  *    The pointers at *argv are filled in with pointers to the
  562.  *    fully-substituted words, and the actual contents of the
  563.  *    words are copied to the buffer at pvPtr.
  564.  *
  565.  *    If an error occurrs then an error message is left in
  566.  *    interp->result and the information at *argv, *argcPtr,
  567.  *    and *pvPtr may be incomplete.
  568.  *
  569.  * Side effects:
  570.  *    The buffer space in pvPtr may be enlarged by calling its
  571.  *    expandProc.
  572.  *
  573.  *--------------------------------------------------------------
  574.  */
  575.  
  576. int
  577. TclParseWords(interp, string, flags, maxWords, termPtr, argcPtr, argv, pvPtr)
  578.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  579.                  * evaluations and error messages. */
  580.     char *string;        /* First character of word. */
  581.     int flags;            /* Flags to control parsing (same values as
  582.                  * passed to Tcl_Eval). */
  583.     int maxWords;        /* Maximum number of words to parse. */
  584.     char **termPtr;        /* Store address of terminating character
  585.                  * here. */
  586.     int *argcPtr;        /* Filled in with actual number of words
  587.                  * parsed. */
  588.     char **argv;        /* Store addresses of individual words here. */
  589.     register ParseValue *pvPtr;    /* Information about where to place
  590.                  * fully-substituted word. */
  591. {
  592.     register char *src, *dst;
  593.     register char c;
  594.     int type, result, argc;
  595.     char *oldBuffer;        /* Used to detect when pvPtr's buffer gets
  596.                  * reallocated, so we can adjust all of the
  597.                  * argv pointers. */
  598.  
  599.     src = string;
  600.     oldBuffer = pvPtr->buffer;
  601.     dst = pvPtr->next;
  602.     for (argc = 0; argc < maxWords; argc++) {
  603.     argv[argc] = dst;
  604.  
  605.     /*
  606.      * Skip leading space.
  607.      */
  608.     
  609.     skipSpace:
  610.     c = *src;
  611.     type = CHAR_TYPE(c);
  612.     while (type == TCL_SPACE) {
  613.         src++;
  614.         c = *src;
  615.         type = CHAR_TYPE(c);
  616.     }
  617.     
  618.     /*
  619.      * Handle the normal case (i.e. no leading double-quote or brace).
  620.      */
  621.  
  622.     if (type == TCL_NORMAL) {
  623.         normalArg:
  624.         while (1) {
  625.         if (dst == pvPtr->end) {
  626.             /*
  627.              * Target buffer space is about to run out.  Make
  628.              * more space.
  629.              */
  630.     
  631.             pvPtr->next = dst;
  632.             (*pvPtr->expandProc)(pvPtr, 1);
  633.             dst = pvPtr->next;
  634.         }
  635.     
  636.         if (type == TCL_NORMAL) {
  637.             copy:
  638.             *dst = c;
  639.             dst++;
  640.             src++;
  641.         } else if (type == TCL_SPACE) {
  642.             goto wordEnd;
  643.         } else if (type == TCL_DOLLAR) {
  644.             int length;
  645.             char *value;
  646.     
  647.             value = Tcl_ParseVar(interp, src, termPtr);
  648.             if (value == NULL) {
  649.             return TCL_ERROR;
  650.             }
  651.             src = *termPtr;
  652.             length = strlen(value);
  653.             if ((pvPtr->end - dst) <= length) {
  654.             pvPtr->next = dst;
  655.             (*pvPtr->expandProc)(pvPtr, length);
  656.             dst = pvPtr->next;
  657.             }
  658.             strcpy(dst, value);
  659.             dst += length;
  660.         } else if (type == TCL_COMMAND_END) {
  661.             if ((c == ']') && !(flags & TCL_BRACKET_TERM)) {
  662.             goto copy;
  663.             }
  664.  
  665.             /*
  666.              * End of command;  simulate a word-end first, so
  667.              * that the end-of-command can be processed as the
  668.              * first thing in a new word.
  669.              */
  670.  
  671.             goto wordEnd;
  672.         } else if (type == TCL_OPEN_BRACKET) {
  673.             pvPtr->next = dst;
  674.             result = TclParseNestedCmd(interp, src+1, flags, termPtr,
  675.                 pvPtr);
  676.             if (result != TCL_OK) {
  677.             return result;
  678.             }
  679.             src = *termPtr;
  680.             dst = pvPtr->next;
  681.         } else if (type == TCL_BACKSLASH) {
  682.             int numRead;
  683.     
  684.             *dst = Tcl_Backslash(src, &numRead);
  685.             if (*dst != 0) {
  686.             dst++;
  687.             }
  688.             src += numRead;
  689.         } else {
  690.             goto copy;
  691.         }
  692.         c = *src;
  693.         type = CHAR_TYPE(c);
  694.         }
  695.     } else {
  696.     
  697.         /*
  698.          * Check for the end of the command.
  699.          */
  700.     
  701.         if (type == TCL_COMMAND_END) {
  702.         if (flags & TCL_BRACKET_TERM) {
  703.             if (c == '\0') {
  704.             Tcl_SetResult(interp, "missing close-bracket",
  705.                 TCL_STATIC);
  706.             return TCL_ERROR;
  707.             }
  708.         } else {
  709.             if (c == ']') {
  710.             goto normalArg;
  711.             }
  712.         }
  713.         goto done;
  714.         }
  715.     
  716.         /*
  717.          * Now handle the special cases: open braces, double-quotes,
  718.          * and backslash-newline.
  719.          */
  720.  
  721.         pvPtr->next = dst;
  722.         if (type == TCL_QUOTE) {
  723.         result = TclParseQuotes(interp, src+1, '"', flags,
  724.             termPtr, pvPtr);
  725.         } else if (type == TCL_OPEN_BRACE) {
  726.         result = TclParseBraces(interp, src+1, termPtr, pvPtr);
  727.         } else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) {
  728.         src += 2;
  729.         goto skipSpace;
  730.         } else {
  731.         goto normalArg;
  732.         }
  733.         if (result != TCL_OK) {
  734.         return result;
  735.         }
  736.     
  737.         /*
  738.          * Back from quotes or braces;  make sure that the terminating
  739.          * character was the end of the word.  Have to be careful here
  740.          * to handle continuation lines (i.e. lines ending in backslash).
  741.          */
  742.     
  743.         c = **termPtr;
  744.         if ((c == '\\') && ((*termPtr)[1] == '\n')) {
  745.         c = (*termPtr)[2];
  746.         }
  747.         type = CHAR_TYPE(c);
  748.         if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
  749.         if (*src == '"') {
  750.             Tcl_SetResult(interp, "extra characters after close-quote",
  751.                 TCL_STATIC);
  752.         } else {
  753.             Tcl_SetResult(interp, "extra characters after close-brace",
  754.                 TCL_STATIC);
  755.         }
  756.         return TCL_ERROR;
  757.         }
  758.         src = *termPtr;
  759.         dst = pvPtr->next;
  760.  
  761.     }
  762.  
  763.     /*
  764.      * We're at the end of a word, so add a null terminator.  Then
  765.      * see if the buffer was re-allocated during this word.  If so,
  766.      * update all of the argv pointers.
  767.      */
  768.  
  769.     wordEnd:
  770.     *dst = '\0';
  771.     dst++;
  772.     if (oldBuffer != pvPtr->buffer) {
  773.         int i;
  774.  
  775.         for (i = 0; i <= argc; i++) {
  776.         argv[i] = pvPtr->buffer + (argv[i] - oldBuffer);
  777.         }
  778.         oldBuffer = pvPtr->buffer;
  779.     }
  780.     }
  781.  
  782.     done:
  783.     pvPtr->next = dst;
  784.     *termPtr = src;
  785.     *argcPtr = argc;
  786.     return TCL_OK;
  787. }
  788.  
  789. /*
  790.  *--------------------------------------------------------------
  791.  *
  792.  * TclExpandParseValue --
  793.  *
  794.  *    This procedure is commonly used as the value of the
  795.  *    expandProc in a ParseValue.  It uses malloc to allocate
  796.  *    more space for the result of a parse.
  797.  *
  798.  * Results:
  799.  *    The buffer space in *pvPtr is reallocated to something
  800.  *    larger, and if pvPtr->clientData is non-zero the old
  801.  *    buffer is freed.  Information is copied from the old
  802.  *    buffer to the new one.
  803.  *
  804.  * Side effects:
  805.  *    None.
  806.  *
  807.  *--------------------------------------------------------------
  808.  */
  809.  
  810. void
  811. TclExpandParseValue(pvPtr, needed)
  812.     register ParseValue *pvPtr;        /* Information about buffer that
  813.                      * must be expanded.  If the clientData
  814.                      * in the structure is non-zero, it
  815.                      * means that the current buffer is
  816.                      * dynamically allocated. */
  817.     int needed;                /* Minimum amount of additional space
  818.                      * to allocate. */
  819. {
  820.     int newSpace;
  821.     char *new;
  822.  
  823.     /*
  824.      * Either double the size of the buffer or add enough new space
  825.      * to meet the demand, whichever produces a larger new buffer.
  826.      */
  827.  
  828.     newSpace = (pvPtr->end - pvPtr->buffer) + 1;
  829.     if (newSpace < needed) {
  830.     newSpace += needed;
  831.     } else {
  832.     newSpace += newSpace;
  833.     }
  834.     new = (char *) ckalloc((unsigned) newSpace);
  835.  
  836.     /*
  837.      * Copy from old buffer to new, free old buffer if needed, and
  838.      * mark new buffer as malloc-ed.
  839.      */
  840.  
  841.     memcpy((VOID *) new, (VOID *) pvPtr->buffer, pvPtr->next - pvPtr->buffer);
  842.     pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
  843.     if (pvPtr->clientData != 0) {
  844.     ckfree(pvPtr->buffer);
  845.     }
  846.     pvPtr->buffer = new;
  847.     pvPtr->end = new + newSpace - 1;
  848.     pvPtr->clientData = (ClientData) 1;
  849. }
  850.  
  851. /*
  852.  *----------------------------------------------------------------------
  853.  *
  854.  * TclWordEnd --
  855.  *
  856.  *    Given a pointer into a Tcl command, find the end of the next
  857.  *    word of the command.
  858.  *
  859.  * Results:
  860.  *    The return value is a pointer to the last character that's part
  861.  *    of the word pointed to by "start".  If the word doesn't end
  862.  *    properly within the string then the return value is the address
  863.  *    of the null character at the end of the string.
  864.  *
  865.  * Side effects:
  866.  *    None.
  867.  *
  868.  *----------------------------------------------------------------------
  869.  */
  870.  
  871. char *
  872. TclWordEnd(start, nested)
  873.     char *start;        /* Beginning of a word of a Tcl command. */
  874.     int nested;            /* Zero means this is a top-level command.
  875.                  * One means this is a nested command (close
  876.                  * brace is a word terminator). */
  877. {
  878.     register char *p;
  879.     int count;
  880.  
  881.     p = start;
  882.     while (isspace(*p)) {
  883.     p++;
  884.     }
  885.  
  886.     /*
  887.      * Handle words beginning with a double-quote or a brace.
  888.      */
  889.  
  890.     if (*p == '"') {
  891.     p = QuoteEnd(p+1, '"');
  892.     if (*p == 0) {
  893.         return p;
  894.     }
  895.     p++;
  896.     } else if (*p == '{') {
  897.     int braces = 1;
  898.     while (braces != 0) {
  899.         p++;
  900.         while (*p == '\\') {
  901.         (void) Tcl_Backslash(p, &count);
  902.         p += count;
  903.         }
  904.         if (*p == '}') {
  905.         braces--;
  906.         } else if (*p == '{') {
  907.         braces++;
  908.         } else if (*p == 0) {
  909.         return p;
  910.         }
  911.     }
  912.     p++;
  913.     }
  914.  
  915.     /*
  916.      * Handle words that don't start with a brace or double-quote.
  917.      * This code is also invoked if the word starts with a brace or
  918.      * double-quote and there is garbage after the closing brace or
  919.      * quote.  This is an error as far as Tcl_Eval is concerned, but
  920.      * for here the garbage is treated as part of the word.
  921.      */
  922.  
  923.     while (1) {
  924.     if (*p == '[') {
  925.         for (p++; *p != ']'; p++) {
  926.         p = TclWordEnd(p, 1);
  927.         if (*p == 0) {
  928.             return p;
  929.         }
  930.         }
  931.         p++;
  932.     } else if (*p == '\\') {
  933.         (void) Tcl_Backslash(p, &count);
  934.         p += count;
  935.         if ((*p == 0) && (count == 2) && (p[-1] == '\n')) {
  936.         return p;
  937.         }
  938.     } else if (*p == '$') {
  939.         p = VarNameEnd(p);
  940.         if (*p == 0) {
  941.         return p;
  942.         }
  943.         p++;
  944.     } else if (*p == ';') {
  945.         /*
  946.          * Include the semi-colon in the word that is returned.
  947.          */
  948.  
  949.         return p;
  950.     } else if (isspace(*p)) {
  951.         return p-1;
  952.     } else if ((*p == ']') && nested) {
  953.         return p-1;
  954.     } else if (*p == 0) {
  955.         if (nested) {
  956.         /*
  957.          * Nested commands can't end because of the end of the
  958.          * string.
  959.          */
  960.         return p;
  961.         }
  962.         return p-1;
  963.     } else {
  964.         p++;
  965.     }
  966.     }
  967. }
  968.  
  969. /*
  970.  *----------------------------------------------------------------------
  971.  *
  972.  * QuoteEnd --
  973.  *
  974.  *    Given a pointer to a string that obeys the parsing conventions
  975.  *    for quoted things in Tcl, find the end of that quoted thing.
  976.  *    The actual thing may be a quoted argument or a parenthesized
  977.  *    index name.
  978.  *
  979.  * Results:
  980.  *    The return value is a pointer to the last character that is
  981.  *    part of the quoted string (i.e the character that's equal to
  982.  *    term).  If the quoted string doesn't terminate properly then
  983.  *    the return value is a pointer to the null character at the
  984.  *    end of the string.
  985.  *
  986.  * Side effects:
  987.  *    None.
  988.  *
  989.  *----------------------------------------------------------------------
  990.  */
  991.  
  992. static char *
  993. QuoteEnd(string, term)
  994.     char *string;        /* Pointer to character just after opening
  995.                  * "quote". */
  996.     int term;            /* This character will terminate the
  997.                  * quoted string (e.g. '"' or ')'). */
  998. {
  999.     register char *p = string;
  1000.     int count;
  1001.  
  1002.     while (*p != term) {
  1003.     if (*p == '\\') {
  1004.         (void) Tcl_Backslash(p, &count);
  1005.         p += count;
  1006.     } else if (*p == '[') {
  1007.         for (p++; *p != ']'; p++) {
  1008.         p = TclWordEnd(p, 1);
  1009.         if (*p == 0) {
  1010.             return p;
  1011.         }
  1012.         }
  1013.         p++;
  1014.     } else if (*p == '$') {
  1015.         p = VarNameEnd(p);
  1016.         if (*p == 0) {
  1017.         return p;
  1018.         }
  1019.         p++;
  1020.     } else if (*p == 0) {
  1021.         return p;
  1022.     } else {
  1023.         p++;
  1024.     }
  1025.     }
  1026.     return p-1;
  1027. }
  1028.  
  1029. /*
  1030.  *----------------------------------------------------------------------
  1031.  *
  1032.  * VarNameEnd --
  1033.  *
  1034.  *    Given a pointer to a variable reference using $-notation, find
  1035.  *    the end of the variable name spec.
  1036.  *
  1037.  * Results:
  1038.  *    The return value is a pointer to the last character that
  1039.  *    is part of the variable name.  If the variable name doesn't
  1040.  *    terminate properly then the return value is a pointer to the
  1041.  *    null character at the end of the string.
  1042.  *
  1043.  * Side effects:
  1044.  *    None.
  1045.  *
  1046.  *----------------------------------------------------------------------
  1047.  */
  1048.  
  1049. static char *
  1050. VarNameEnd(string)
  1051.     char *string;        /* Pointer to dollar-sign character. */
  1052. {
  1053.     register char *p = string+1;
  1054.  
  1055.     if (*p == '{') {
  1056.     for (p++; (*p != '}') && (*p != 0); p++) {
  1057.         /* Empty loop body. */
  1058.     }
  1059.     return p;
  1060.     }
  1061.     while (isalnum(*p) || (*p == '_')) {
  1062.     p++;
  1063.     }
  1064.     if ((*p == '(') && (p != string+1)) {
  1065.     return QuoteEnd(p+1, ')');
  1066.     }
  1067.     return p-1;
  1068. }
  1069.  
  1070. /*
  1071.  *----------------------------------------------------------------------
  1072.  *
  1073.  * Tcl_ParseVar --
  1074.  *
  1075.  *    Given a string starting with a $ sign, parse off a variable
  1076.  *    name and return its value.
  1077.  *
  1078.  * Results:
  1079.  *    The return value is the contents of the variable given by
  1080.  *    the leading characters of string.  If termPtr isn't NULL,
  1081.  *    *termPtr gets filled in with the address of the character
  1082.  *    just after the last one in the variable specifier.  If the
  1083.  *    variable doesn't exist, then the return value is NULL and
  1084.  *    an error message will be left in interp->result.
  1085.  *
  1086.  * Side effects:
  1087.  *    None.
  1088.  *
  1089.  *----------------------------------------------------------------------
  1090.  */
  1091.  
  1092. char *
  1093. Tcl_ParseVar(interp, string, termPtr)
  1094.     Tcl_Interp *interp;            /* Context for looking up variable. */
  1095.     register char *string;        /* String containing variable name.
  1096.                      * First character must be "$". */
  1097.     char **termPtr;            /* If non-NULL, points to word to fill
  1098.                      * in with character just after last
  1099.                      * one in the variable specifier. */
  1100.  
  1101. {
  1102.     char *name1, *name1End, c, *result;
  1103.     register char *name2;
  1104. #define NUM_CHARS 200
  1105.     char copyStorage[NUM_CHARS];
  1106.     ParseValue pv;
  1107.  
  1108.     /*
  1109.      * There are three cases:
  1110.      * 1. The $ sign is followed by an open curly brace.  Then the variable
  1111.      *    name is everything up to the next close curly brace, and the
  1112.      *    variable is a scalar variable.
  1113.      * 2. The $ sign is not followed by an open curly brace.  Then the
  1114.      *    variable name is everything up to the next character that isn't
  1115.      *    a letter, digit, or underscore.  If the following character is an
  1116.      *    open parenthesis, then the information between parentheses is
  1117.      *    the array element name, which can include any of the substitutions
  1118.      *    permissible between quotes.
  1119.      * 3. The $ sign is followed by something that isn't a letter, digit,
  1120.      *    or underscore:  in this case, there is no variable name, and "$"
  1121.      *    is returned.
  1122.      */
  1123.  
  1124.     name2 = NULL;
  1125.     string++;
  1126.     if (*string == '{') {
  1127.     string++;
  1128.     name1 = string;
  1129.     while (*string != '}') {
  1130.         if (*string == 0) {
  1131.         Tcl_SetResult(interp, "missing close-brace for variable name",
  1132.             TCL_STATIC);
  1133.         if (termPtr != 0) {
  1134.             *termPtr = string;
  1135.         }
  1136.         return NULL;
  1137.         }
  1138.         string++;
  1139.     }
  1140.     name1End = string;
  1141.     string++;
  1142.     } else {
  1143.     name1 = string;
  1144.     while (isalnum(*string) || (*string == '_')) {
  1145.         string++;
  1146.     }
  1147.     if (string == name1) {
  1148.         if (termPtr != 0) {
  1149.         *termPtr = string;
  1150.         }
  1151.         return "$";
  1152.     }
  1153.     name1End = string;
  1154.     if (*string == '(') {
  1155.         char *end;
  1156.  
  1157.         /*
  1158.          * Perform substitutions on the array element name, just as
  1159.          * is done for quotes.
  1160.          */
  1161.  
  1162.         pv.buffer = pv.next = copyStorage;
  1163.         pv.end = copyStorage + NUM_CHARS - 1;
  1164.         pv.expandProc = TclExpandParseValue;
  1165.         pv.clientData = (ClientData) NULL;
  1166.         if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
  1167.             != TCL_OK) {
  1168.         char msg[100];
  1169.         sprintf(msg, "\n    (parsing index for array \"%.*s\")",
  1170.             string-name1, name1);
  1171.         Tcl_AddErrorInfo(interp, msg);
  1172.         result = NULL;
  1173.         name2 = pv.buffer;
  1174.         if (termPtr != 0) {
  1175.             *termPtr = end;
  1176.         }
  1177.         goto done;
  1178.         }
  1179.         string = end;
  1180.         name2 = pv.buffer;
  1181.     }
  1182.     }
  1183.     if (termPtr != 0) {
  1184.     *termPtr = string;
  1185.     }
  1186.  
  1187.     if (((Interp *) interp)->noEval) {
  1188.     return "";
  1189.     }
  1190.     c = *name1End;
  1191.     *name1End = 0;
  1192.     result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
  1193.     *name1End = c;
  1194.  
  1195.     done:
  1196.     if ((name2 != NULL) && (pv.buffer != copyStorage)) {
  1197.     ckfree(pv.buffer);
  1198.     }
  1199.     return result;
  1200. }
  1201.